Fix sorting of keys and add test

Fixes #233

diff --git a/which-key-tests.el b/which-key-tests.el
index cff7fab56e639abc65588cf1a0c71194996eef5e..81797975184fdcedee4ce1deb4810f350d38be00 100644 (file)
--- a/which-key-tests.el
+++ b/which-key-tests.el
@@ -148,5 +148,70 @@
                ("e e e" . "eee")
                ("f" . "{ - C-f"))))))
 
+(ert-deftest which-key-test--key-sorting ()
+  (let ((keys '(("a" . "z")
+                ("A" . "Z")
+                ("b" . "y")
+                ("B" . "Y")
+                ("p" . "Prefix")
+                ("SPC" . "x")
+                ("C-a" . "w"))))
+    (let ((which-key-sort-uppercase-first t))
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order))
+        '("SPC" "A" "B" "a" "b" "p" "C-a"))))
+    (let (which-key-sort-uppercase-first)
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order))
+        '("SPC" "a" "b" "p" "A" "B" "C-a"))))
+    (let ((which-key-sort-uppercase-first t))
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha))
+        '("SPC" "a" "A" "b" "B" "p" "C-a"))))
+    (let (which-key-sort-uppercase-first)
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha))
+        '("SPC" "A" "a" "B" "b" "p" "C-a"))))
+    (let ((which-key-sort-uppercase-first t))
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys)
+                           'which-key-prefix-then-key-order))
+        '("SPC" "A" "B" "a" "b" "C-a" "p"))))
+    (let (which-key-sort-uppercase-first)
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys)
+                           'which-key-prefix-then-key-order))
+        '("SPC" "a" "b" "A" "B" "C-a" "p"))))
+    (let ((which-key-sort-uppercase-first t))
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys)
+                           'which-key-prefix-then-key-order-reverse))
+        '("p" "SPC" "A" "B" "a" "b" "C-a"))))
+    (let (which-key-sort-uppercase-first)
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys)
+                           'which-key-prefix-then-key-order-reverse))
+        '("p" "SPC" "a" "b" "A" "B" "C-a"))))
+    (let ((which-key-sort-uppercase-first t))
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys)
+                           'which-key-description-order))
+        '("p" "C-a" "SPC" "b" "B" "a" "A"))))
+    (let (which-key-sort-uppercase-first)
+      (should
+       (equal
+        (mapcar 'car (sort (copy-sequence keys)
+                           'which-key-description-order))
+        '("p" "C-a" "SPC" "b" "B" "a" "A"))))))
+
 (provide 'which-key-tests)
 ;;; which-key-tests.el ends here

diff --git a/which-key.el b/which-key.el
index 09f50417ab72bb0d989e8098f6bbaaad81cad1c6..f7bab55d317d8665aab948222e6c5315b1963ff6 100644 (file)
--- a/which-key.el
+++ b/which-key.el
@@ -1315,14 +1315,24 @@ width) in lines and characters respectively."
 ;;; Sorting functions
 
 (defun which-key--string< (a b &optional alpha)
-  (let* ((da (downcase a))
-         (db (downcase b)))
-    (cond ((string-equal da db)
-           (if which-key-sort-uppercase-first
-               (string-lessp a b)
-             (not (string-lessp a b))))
-          (alpha (string-lessp da db))
-          (t (string-lessp a b)))))
+  (let ((da (downcase a))
+        (db (downcase b)))
+    (cond
+     ((and alpha (not which-key-sort-uppercase-first))
+      (if (string-equal da db)
+          (string-lessp a b)
+        (string-lessp da db)))
+     ((and alpha which-key-sort-uppercase-first)
+      (if (string-equal da db)
+          (not (string-lessp a b))
+        (string-lessp da db)))
+     ((not which-key-sort-uppercase-first)
+      (let ((aup (not (string-equal da a)))
+            (bup (not (string-equal db b))))
+        (if (not (xor aup bup))
+            (string-lessp a b)
+          bup)))
+     (t (string-lessp a b)))))
 
 (defun which-key--key-description< (a b &optional alpha)
   "Sorting function used for `which-key-key-order' and